home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / ARCHIVES.BAS < prev    next >
BASIC Source File  |  1993-01-09  |  10KB  |  306 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
  8.    DECLARE FUNCTION Exist2% (FileName$)
  9.    DECLARE SUB FGetLoc (BYVAL FileHandle%, Posn&)
  10.    DECLARE SUB FindNextA (ErrCode%)
  11.    DECLARE SUB FOpen1 (FileName$, BYVAL ReadWrite%, BYVAL Sharing%, FileHandle%, ErrCode%)
  12.    DECLARE SUB FSetLoc (BYVAL FileHandle%, Posn&)
  13.    DECLARE SUB GetNameA (FileName$, FileNameLen%)
  14.    DECLARE SUB MatchFile (PatternName$, FileName$, IsMatch%)
  15.    DECLARE SUB ParseFSpec (FileSpec$, Drive$, DLen%, Subdir$, SLen%, File$, FLen%)
  16.    DECLARE SUB SFRead (BYVAL FileHandle%, St$, BytesRead%, ErrCode%)
  17.  
  18.    DECLARE SUB GetArc00 (Handle%, ArcType%, File$, Header$)
  19.    DECLARE SUB SetArc00 (BYVAL Handle%, BYVAL ArcType%, File$, Header$)
  20.  
  21.  
  22.  
  23. SUB FindFirstA (Archive$, FileName$, ErrCode%)
  24.    ErrCode% = 0
  25.    File$ = LEFT$(FileName$, 12)
  26.    Arc$ = UCASE$(Archive$)
  27.  
  28.    IF INSTR(Arc$, ".") = 0 THEN
  29.       IF Exist2%(Arc$ + ".ZIP") THEN
  30.          Arc$ = Arc$ + ".ZIP"
  31.       ELSEIF Exist2%(Arc$ + ".LZH") THEN
  32.          Arc$ = Arc$ + ".LZH"
  33.       ELSEIF Exist2%(Arc$ + ".ARC") THEN
  34.          Arc$ = Arc$ + ".ARC"
  35.       ELSEIF Exist2%(Arc$ + ".PAK") THEN
  36.          Arc$ = Arc$ + ".PAK"
  37.       ELSEIF Exist2%(Arc$ + ".ZOO") THEN
  38.          Arc$ = Arc$ + ".ZOO"
  39.       ELSEIF Exist2%(Arc$ + ".ARJ") THEN
  40.          Arc$ = Arc$ + ".ARJ"
  41.       ELSEIF Exist2%(Arc$ + ".EXE") THEN
  42.          Arc$ = Arc$ + ".EXE"
  43.       ELSEIF Exist2%(Arc$ + ".COM") THEN
  44.          Arc$ = Arc$ + ".COM"
  45.       ELSE
  46.          Arc$ = Arc$ + "."
  47.       END IF
  48.    END IF
  49.  
  50.    SELECT CASE RIGHT$(Arc$, 3)
  51.       CASE "ARC", "PAK"
  52.          ArcType% = 1
  53.       CASE "LZH"
  54.          ArcType% = 2
  55.       CASE "ZIP"
  56.          ArcType% = 3
  57.       CASE "ZOO"
  58.          ArcType% = 4
  59.       CASE "ARJ"
  60.          ArcType% = 5
  61.       CASE "COM", "EXE"
  62.          ArcType% = -1
  63.       CASE ELSE
  64.          ErrCode% = 9999
  65.    END SELECT
  66.  
  67.    Posn& = 1&
  68.  
  69.    IF ErrCode% = 0 THEN FOpen1 Arc$, 0, 2, Handle%, ErrCode%
  70.    IF ErrCode% = 0 AND ArcType% = -1 THEN
  71.       Header$ = "xx"
  72.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  73.       IF ErrCode% = 0 THEN IF Header$ <> "MZ" THEN ErrCode% = 9999
  74.       IF ErrCode% = 0 THEN                       ' check for LHARC .EXE
  75.          FSetLoc Handle%, 1637&
  76.          Header$ = SPACE$(8)
  77.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  78.          IF ErrCode% = 0 THEN
  79.             IF MID$(Header$, 3, 3) = "-lh" THEN
  80.                ArcType% = 2
  81.                FSetLoc Handle%, 1637&
  82.                Posn& = 1637&
  83.             END IF
  84.          END IF
  85.       END IF
  86.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for PKZIP .EXE
  87.          FSetLoc Handle%, 12785&
  88.          Header$ = SPACE$(4)
  89.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  90.          IF ErrCode% = 0 THEN
  91.             IF LEFT$(Header$, 4) = "PK" + CHR$(3) + CHR$(4) THEN
  92.                ArcType% = 3
  93.                FSetLoc Handle%, 12785&
  94.                Posn& = 12785&
  95.             ELSE
  96.                ErrCode% = 9999
  97.             END IF
  98.          END IF
  99.       END IF
  100.    END IF
  101.    IF ErrCode% = 0 THEN
  102.       Header$ = SPACE$(128)
  103.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  104.       SetArc00 Handle%, ArcType%, File$, Header$
  105.       SELECT CASE ArcType%
  106.          CASE 1
  107.             IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  108.          CASE 2
  109.             IF MID$(Header$, 3, 1) <> "-" THEN ErrCode% = 9999
  110.          CASE 3
  111.             IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  112.          CASE 4
  113.             IF MID$(Header$, 21, 4) = CHR$(&HDC) + CHR$(&HA7) + CHR$(&HC4) + CHR$(&HFD) THEN
  114.                Posn& = CVL(MID$(Header$, &H19, 4)) + 1&
  115.                FSetLoc Handle%, Posn&
  116.                SFRead Handle%, Header$, BytesRead%, ErrCode%
  117.             ELSE
  118.                ErrCode% = 9999
  119.             END IF
  120.          CASE 5
  121.             IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) THEN ErrCode% = 9999
  122.       END SELECT
  123.       IF ErrCode% < 0 THEN
  124.          IF BytesRead% THEN
  125.             ErrCode% = 0
  126.             Header$ = LEFT$(Header$, BytesRead%)
  127.          END IF
  128.       END IF
  129.       IF ErrCode% = 0 THEN
  130.          SetArc00 Handle%, ArcType%, File$, Header$
  131.          FSetLoc Handle%, Posn&
  132.          CurFile$ = SPACE$(80)
  133.          GetNameA CurFile$, FLen%
  134.          IF FLen% THEN
  135.             FileSpec$ = LEFT$(CurFile$, FLen%)
  136.             Drive$ = " "
  137.             SubDir$ = SPACE$(64)
  138.             CurFile$ = SPACE$(12)
  139.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  140.             Drive$ = LEFT$(Drive$, DLen%)
  141.             SubDir$ = LEFT$(SubDir$, SLen%)
  142.             CurFile$ = LEFT$(CurFile$, FLen%)
  143.             MatchFile File$, CurFile$, Found%
  144.          ELSE
  145.             Found% = 0
  146.          END IF
  147.       END IF
  148.       IF ErrCode% OR NOT Found% THEN
  149.          FindNextA ErrCode%
  150.       END IF
  151.    END IF
  152. END SUB
  153.  
  154.  
  155.  
  156. SUB FindNextA (ErrCode%)
  157.    File$ = SPACE$(12)
  158.    Header$ = SPACE$(128)
  159.    GetArc00 Handle%, ArcType%, File$, Header$
  160.    IF Handle% THEN
  161.       File$ = RTRIM$(File$)
  162.    ELSE
  163.       ErrCode% = -1
  164.    END IF
  165.    DO UNTIL ErrCode% OR Found%
  166.       FGetLoc Handle%, Posn&
  167.       SELECT CASE ArcType%
  168.          CASE 1
  169.             IF AscM%(Header$, 2) = 1 THEN
  170.                Posn& = Posn& + 25&
  171.             ELSE
  172.                Posn& = Posn& + 29&
  173.             END IF
  174.             Posn& = Posn& + CVL(MID$(Header$, 16, 4))
  175.          CASE 2
  176.             Posn& = Posn& + (ASC(Header$) + 2) + CVL(MID$(Header$, 8, 4))
  177.          CASE 3
  178.             Posn& = Posn& + 30& + CVI(MID$(Header$, 27, 2))
  179.             Posn& = Posn& + CVI(MID$(Header$, 29, 2))
  180.             Posn& = Posn& + CVL(MID$(Header$, 19, 4))
  181.          CASE 4
  182.             Posn& = CVL(MID$(Header$, 7, 4)) + 1&
  183.          CASE 5
  184.             Posn& = Posn& + CLNG(CVI(MID$(Header$, 3, 2))) + CVL(MID$(Header$, 17, 4)) + 10&
  185.       END SELECT
  186.       IF ErrCode% = 0 THEN
  187.          FSetLoc Handle%, Posn&
  188.          Header$ = SPACE$(128)
  189.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  190.       END IF
  191.       IF ErrCode% < 0 THEN
  192.          IF BytesRead% THEN
  193.             ErrCode% = 0
  194.             Header$ = LEFT$(Header$, BytesRead%)
  195.          END IF
  196.       END IF
  197.       SELECT CASE ArcType%
  198.          CASE 1: IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  199.          CASE 2: IF MID$(Header$, 3, 1) <> "-" OR LEFT$(Header$, 1) = CHR$(0) THEN ErrCode% = 9999
  200.          CASE 3: IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  201.          CASE 5: IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) OR CVI(MID$(Header$, 3, 2)) = 0 THEN ErrCode% = 9999
  202.       END SELECT
  203.       IF ErrCode% = 0 THEN
  204.          SetArc00 Handle%, ArcType%, File$, Header$
  205.          FSetLoc Handle%, Posn&
  206.          CurFile$ = SPACE$(12)
  207.          GetNameA CurFile$, FLen%
  208.          IF FLen% THEN
  209.             FileSpec$ = LEFT$(CurFile$, FLen%)
  210.             Drive$ = " "
  211.             SubDir$ = SPACE$(64)
  212.             CurFile$ = SPACE$(12)
  213.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  214.             Drive$ = LEFT$(Drive$, DLen%)
  215.             SubDir$ = LEFT$(SubDir$, SLen%)
  216.             CurFile$ = LEFT$(CurFile$, FLen%)
  217.             MatchFile File$, CurFile$, Found%
  218.          ELSE
  219.             Found% = 0
  220.          END IF
  221.       END IF
  222.    LOOP
  223. END SUB
  224.  
  225.  
  226.  
  227. SUB GetNameA (FileName$, FLen%)
  228.    File$ = SPACE$(12)
  229.    Header$ = SPACE$(128)
  230.    GetArc00 Handle%, ArcType%, File$, Header$
  231.    SELECT CASE ArcType%
  232.       CASE 1
  233.          St$ = MID$(Header$, 3, 13)
  234.          FLen% = INSTR(St$, CHR$(0))
  235.          IF FLen% THEN
  236.             FLen% = FLen% - 1
  237.          ELSE
  238.             FLen% = 12
  239.